CD Ware Multimedia 1995 May/cd Ware (Juegos) Epimundo.iso/WIN/VB_DB/PDXBRO.ZIP/MAIN.TXT

Text File | 1991-07-23 | 4.1 KB | 188 lines

Dim AlarmTime!
Dim DidRing%
Const appname$ = "pdxbro"

Sub Form_Load ()
    DidRing% = FALSE
    AlarmTime! = Timer + 600
    For x = 1 To 6
        inuse%(x) = FALSE
    Next
    If pdoxInit%(appname$, 2) <> TRUE Then
        MsgBox pxerrmsg$(pxerr%), 16, "Engine Init Error"
        If pdoxExit%() <> TRUE Then
            MsgBox pxerrmsg$(pxerr%), 16, "Engine Exit Error"
        End If
        End
    End If

End Sub

Sub FileOpen_Click ()
    setMousePointer (11)            'place hourglass
    x = 1
    Spec$ = "*.DB"
    fcaption$ = "Pick a Paradox Table"
    ftext$ = "Open a table."
    openOK = FALSE
    For x = 1 To 2      '5
        If inuse%(x) = FALSE Then
            setMousePointer (0)
            tablename$(x) = MhFileSelector2$(Spec$, fcaption$, ftext$)
            If Len(tablename$(x)) Then
                inuse%(x) = TRUE
                openOK = TRUE
            Else
                openOK = FALSE
                MsgBox "No file selected.", 64, "Open Error"
                Exit Sub
            End If
            Exit For
        End If
    Next x
    If openOK = FALSE Then
        setMousePointer (0)
        MsgBox "Too many tables open.", 64, "Open Error"
        Exit Sub
    End If


    Select Case x
        Case 1
            ClearFldForm
            Load Form1
            If Form1.text2.text = "Quit" Then
                Unload Form1
            End If

        Case 2
            ClearFldForm
            Load Form2
            If Form2.text2.text = "Quit" Then
                Unload Form2
            End If

    '    Case 3
    '        ClearFldForm
    '        Load Form3
    '        If Form3.text2.text = "Quit" Then
    '            Unload Form3
    '        End If
    '
    '    Case 4
    '        ClearFldForm
    '        Load Form4
    '        If Form4.text2.text = "Quit" Then
    '            Unload Form4
    '        End If
    '
    '    Case 5
    '        ClearFldForm
    '        Load Form5
    '        If Form5.text2.text = "Quit" Then
    '            Unload Form5
    '        End If
    '
    End Select

    Exit Sub



End Sub

Sub FileExit_Click ()
    If pdoxExit%() <> TRUE% Then
        MsgBox pxerrmsg$(pxerr%), 16, "Engine Exit Error"
    End If
    End
End Sub

Function pdoxInit% (appname$, share%)
    pxerr% = pxwininit%(appname$, share%)
    If pxerr% <> PXSUCCESS% Then
        pdoxInit% = FALSE
    Else
        pdoxInit% = TRUE
    End If
End Function

Sub PdoxEng_Click ()
    Dim handle%
    handle% = Shell("PxEngCfg.Exe", 1)
End Sub

Sub PdoxInter_Click ()
    Dim handle%
    handle% = Shell("Paradox.Pif", 3)
End Sub

Sub myWin_Click (Index As Integer)
    Select Case Index
        Case 1
            Form1.SetFocus
        Case 2
            Form2.SetFocus
'        Case 3
'            Form3.SetFocus
'        Case 4
'            Form4.SetFocus
'        Case 5
'            Form5.SetFocus
    End Select
End Sub

Sub Timer1_Timer ()
    If (AlarmTime! < Timer And DidRing% = FALSE) Then
        mhAlarm1.Visible = TRUE
        mhAlarm1.Ringon = 2
    End If

End Sub

Sub MhAlarm1_Click ()
    Timer2.Enabled = TRUE
    Timer1.Enabled = FALSE
'    AlarmTime! = Timer + 10
'    mhAlarm1.Ringon = 0
'    mhAlarm1.Visible = FALSE

End Sub

Function pdoxExit% ()
    pxerr% = pxExit%()
    If pxerr% <> PXSUCCESS% Then
        pdoxExit% = FALSE%
    Else
        pdoxExit% = TRUE%
    End If

End Function

Sub ClearFldForm ()
    Do While form1d.sourceflds.listcount
        form1d.sourceflds.RemoveItem 0
    Loop
    Do While form1d.displayflds.listcount
        form1d.displayflds.RemoveItem 0
    Loop
End Sub

Sub Timer2_Timer ()
    DidRing% = FALSE
    AlarmTime! = Timer + 10
    mhAlarm1.Ringon = 0
    mhAlarm1.Visible = FALSE%
    Timer2.Enabled = FALSE
    Timer1.Enabled = TRUE
End Sub

Sub MhAlarm1_DblClick ()
    DidRing% = TRUE
    Timer1.Enabled = FALSE
    Timer2.Enabled = FALSE
    mhAlarm1.Visible = FALSE
    mhAlarm1.Ringon = 0
End Sub